home *** CD-ROM | disk | FTP | other *** search
/ Mac-Source 1994 July / Mac-Source_July_1994.iso / Other Langs / Tickle-4.0 (tcl) / src / tcl-cbtree.c < prev    next >
Encoding:
C/C++ Source or Header  |  1993-11-19  |  10.2 KB  |  501 lines  |  [TEXT/MPS ]
  1.  
  2. /*
  3. ** This source code was written by Tim Endres
  4. ** Email: time@ice.com.
  5. ** USMail: 8840 Main Street, Whitmore Lake, MI  48189
  6. **
  7. ** Some portions of this application utilize sources
  8. ** that are copyrighted by ICE Engineering, Inc., and
  9. ** ICE Engineering retains all rights to those sources.
  10. **
  11. ** Neither ICE Engineering, Inc., nor Tim Endres, 
  12. ** warrants this source code for any reason, and neither
  13. ** party assumes any responsbility for the use of these
  14. ** sources, libraries, or applications. The user of these
  15. ** sources and binaries assumes all responsbilities for
  16. ** any resulting consequences.
  17. */
  18.  
  19.  
  20. #pragma segment TCLCBTREE
  21.  
  22. #include "tickle.h"
  23. #include "tcl.h"
  24.  
  25. #include "cdefs.h"
  26. #include "db.h"
  27. #include "btree.h"
  28.  
  29. extern int errno;
  30. extern int macintoshErr;
  31.  
  32.  
  33. typedef struct {
  34.     DB        *db;
  35.     char    name[32];
  36.     } CBTREE_NAMED_DB;
  37.  
  38. #define MAX_DBS        8
  39.  
  40. static int                _max_dbs_ = 0;
  41. static CBTREE_NAMED_DB    *_dbs_ = NULL;
  42.  
  43. init_tcl_cbtree()
  44.     {
  45.     int        i;
  46.     
  47.     _dbs_ = (CBTREE_NAMED_DB *) malloc(sizeof(CBTREE_NAMED_DB) * MAX_DBS);
  48.     if (_dbs_ == NULL)
  49.         _max_dbs_ = 0;
  50.     else
  51.         _max_dbs_ = MAX_DBS;
  52.     
  53.     for (i=0; i<_max_dbs_; ++i)
  54.         {
  55.         _dbs_[i].db = (DB *)0;
  56.         _dbs_[i].name[0] = '\0';
  57.         }
  58.     }
  59.  
  60. close_tcl_cbtree()
  61.     {
  62.     int        i;
  63.     
  64.     for (i=0; i<_max_dbs_; ++i)
  65.         {
  66.         if (_dbs_[i].db != (DB *)0)
  67.             (* _dbs_[i].db->close)(_dbs_[i].db);
  68.         }
  69.     }
  70.  
  71. int
  72. tcl_btree_cmp(p1, p2)
  73. char    *p1, *p2;
  74.     {
  75.     /*fprintf(stderr, "my_btree_cmp: p1 x%lx '%s' p2 x%lx '%s'\n", p1, p1, p2, p2);*/
  76.     return strcmp(p1, p2);
  77.     }
  78.  
  79. int
  80. Cmd_CBTOpen(clientData, interp, argc, argv)
  81.     char        *clientData;
  82.     Tcl_Interp    *interp;
  83.     int            argc;
  84.     char        **argv;
  85.     {
  86.     short    wdRefNum;
  87.     int        index, push_err, myerr;
  88. #pragma unused (clientData)
  89.  
  90.     if (argc != 3)
  91.         {
  92.         Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  93.             " dbName dbFileName\"", (char *) NULL);
  94.         return TCL_ERROR;
  95.         }
  96.  
  97.     for (index = 0 ; index < _max_dbs_ ; ++index)
  98.         {
  99.         if (_dbs_[index].db == NULL)
  100.             break;
  101.         
  102.         if (strcmp(_dbs_[index].name, argv[1]) == SAMESTR)
  103.             {
  104.             Tcl_AppendResult(interp, "\"", argv[0], "\" duplicate DB name '",
  105.                                     argv[1], "'", (char *) NULL);
  106.             return TCL_ERROR;
  107.             }
  108.         }
  109.  
  110.     if (index >= _max_dbs_)
  111.         {
  112.         Tcl_AppendResult(interp, "\"", argv[0], "\" max DB's open", (char *) NULL);
  113.         return TCL_ERROR;
  114.         }
  115.     else
  116.         {
  117.         BTREEINFO openinfo;
  118.  
  119.         myerr = TclMac_CWDCreateWD(&wdRefNum);
  120.         if (myerr != noErr)
  121.             {
  122.             Tcl_AppendResult(interp, "could not create working directory - ",
  123.                                 Tcl_MacGetError(interp, myerr), NULL);
  124.             return TCL_ERROR;
  125.             }
  126.         
  127.         push_err = TclMac_CWDPushVol();
  128.         
  129.         openinfo.flags = R_DUP;
  130.         openinfo.cachesize = 0;
  131.         openinfo.compare = tcl_btree_cmp;    /* use strcmp() */
  132.         openinfo.lorder = BIG_ENDIAN;
  133.         openinfo.psize = 4096;
  134.         
  135.         SetVol(NULL, wdRefNum);
  136.         _dbs_[index].db = btree_open(argv[2], O_RDWR | O_CREAT, 0666, &openinfo);
  137.  
  138.         if (push_err == noErr)
  139.             TclMac_CWDPopVol();
  140.         
  141.         TclMac_CWDDisposeWD(wdRefNum);
  142.     
  143.         if (_dbs_[index].db == (DB *)0)
  144.             {
  145.             strcpy(_dbs_[index].name, "--CLOSED--");
  146.             Tcl_AppendResult(interp, "\"", argv[0], "\" error opening DB", (char *) NULL);
  147.             return TCL_ERROR;
  148.             }
  149.         else
  150.             {
  151.             strcpy(_dbs_[index].name, argv[1]);
  152.             return TCL_OK;
  153.             }
  154.         }
  155.     }
  156.  
  157. int
  158. Cmd_CBTInsert(clientData, interp, argc, argv)
  159. char        *clientData;
  160. Tcl_Interp    *interp;
  161. int            argc;
  162. char        **argv;
  163. {
  164. int        index, result;
  165. DBT        key,
  166.         data;
  167. #pragma unused (clientData)
  168.  
  169.     if (argc != 4 && argc != 5)
  170.         {
  171.         Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  172.             " dbName key data ?replace?\"", (char *) NULL);
  173.         return TCL_ERROR;
  174.         }
  175.  
  176.     for (index = 0 ; index < _max_dbs_ ; ++index)
  177.         {
  178.         if (strcmp(_dbs_[index].name, argv[1]) == SAMESTR)
  179.             break;
  180.         }
  181.  
  182.     if (index >= _max_dbs_)
  183.         {
  184.         Tcl_AppendResult(interp, "\"", argv[0], "\" DB \"",
  185.                             argv[1], "\" not found", (char *) NULL);
  186.         return TCL_ERROR;
  187.         }
  188.     else
  189.         {
  190.         key.data = argv[2];
  191.         key.size = strlen(argv[2]) + 1;
  192.         data.data = argv[3];
  193.         data.size = strlen(argv[3]) + 1;
  194.         
  195.         result = (* _dbs_[index].db->put) ( _dbs_[index].db, &key, &data,
  196.                                     (argc == 4 ? R_PUT : R_NOOVERWRITE) );
  197.         if (result < 0)
  198.             {
  199.             Tcl_AppendResult(interp, "\"", argv[0], "\" error storing data", (char *) NULL);
  200.             return TCL_ERROR;
  201.             }
  202.         else if (result > 0)
  203.             {
  204.             Tcl_AppendResult(interp, "\"", argv[0], "\" key already exists", (char *) NULL);
  205.             return TCL_ERROR;
  206.             }
  207.         else
  208.             {
  209.             return TCL_OK;
  210.             }
  211.         }
  212.     }
  213.  
  214. int
  215. Cmd_CBTGetKey(clientData, interp, argc, argv)
  216. char        *clientData;
  217. Tcl_Interp    *interp;
  218. int            argc;
  219. char        **argv;
  220. {
  221. int        index, result;
  222. DBT        key,
  223.         data;
  224. #pragma unused (clientData)
  225.  
  226.     if (argc != 3 && argc != 4)
  227.         {
  228.         Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  229.             " dbName key ?varName?\"", (char *) NULL);
  230.         return TCL_ERROR;
  231.         }
  232.  
  233.     for (index = 0 ; index < _max_dbs_ ; ++index)
  234.         {
  235.         if (strcmp(_dbs_[index].name, argv[1]) == SAMESTR)
  236.             break;
  237.         }
  238.  
  239.     if (index >= _max_dbs_)
  240.         {
  241.         Tcl_AppendResult(interp, "\"", argv[0], "\" DB \"",
  242.                             argv[1], "\" not found", (char *) NULL);
  243.         return TCL_ERROR;
  244.         }
  245.     else
  246.         {
  247.         key.data = argv[2];
  248.         key.size = strlen(argv[2]) + 1;
  249.         
  250.         result = (* _dbs_[index].db->get) ( _dbs_[index].db, &key, &data, 0 );
  251.  
  252.         if (result < 0)
  253.             {
  254.             Tcl_AppendResult(interp, "\"", argv[0], "\" key \"", argv[2],
  255.                                 "\" DB error", (char *) NULL);
  256.             return TCL_ERROR;
  257.             }
  258.         if (result > 0)
  259.             {
  260.             Tcl_AppendResult(interp, "\"", argv[0], "\" key \"", argv[2],
  261.                                 "\" not found", (char *) NULL);
  262.             return TCL_ERROR;
  263.             }
  264.         else
  265.             {
  266.             if (argc == 4)
  267.                 Tcl_SetVar(interp, argv[3], data.data, 0);
  268.             else
  269.                 Tcl_AppendResult(interp, data.data, (char *) NULL);
  270.             
  271.             return TCL_OK;
  272.             }
  273.         }
  274.     }
  275.  
  276. int
  277. Cmd_CBTDelete(clientData, interp, argc, argv)
  278. char        *clientData;
  279. Tcl_Interp    *interp;
  280. int            argc;
  281. char        **argv;
  282. {
  283. int        index, result;
  284. DBT        key;
  285. #pragma unused (clientData)
  286.  
  287.     if (argc != 3)
  288.         {
  289.         Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  290.             " dbName key\"", (char *) NULL);
  291.         return TCL_ERROR;
  292.         }
  293.  
  294.     for (index = 0 ; index < _max_dbs_ ; ++index)
  295.         {
  296.         if (strcmp(_dbs_[index].name, argv[1]) == SAMESTR)
  297.             break;
  298.         }
  299.  
  300.     if (index >= _max_dbs_)
  301.         {
  302.         Tcl_AppendResult(interp, "\"", argv[0], "\" DB \"",
  303.                             argv[1], "\" not found", (char *) NULL);
  304.         return TCL_ERROR;
  305.         }
  306.     else
  307.         {
  308.         key.data = argv[2];
  309.         key.size = strlen(argv[2]) + 1;
  310.         
  311.         result = (* _dbs_[index].db->del) ( _dbs_[index].db, &key, 0);
  312.  
  313.         if (result < 0)
  314.             {
  315.             Tcl_AppendResult(interp, "\"", argv[0], "\" key \"", argv[2],
  316.                                 "\" DB error", (char *) NULL);
  317.             return TCL_ERROR;
  318.             }
  319.         if (result > 0)
  320.             {
  321.             Tcl_AppendResult(interp, "\"", argv[0], "\" key \"", argv[2],
  322.                                 "\" not found", (char *) NULL);
  323.             return TCL_ERROR;
  324.             }
  325.         else
  326.             {
  327.             return TCL_OK;
  328.             }
  329.         }
  330.     }
  331.  
  332. int
  333. Cmd_CBTSeq(clientData, interp, argc, argv)
  334. char        *clientData;
  335. Tcl_Interp    *interp;
  336. int            argc;
  337. char        **argv;
  338. {
  339. int        index, result;
  340. DBT        key, data;
  341. char    *dvarname;
  342. char    *kvarname;
  343. unsigned long flags;
  344. #pragma unused (clientData)
  345.  
  346.     if (argc < 3 || argc > 6)
  347.         {
  348.         Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  349.             " dbName FIRST|LAST|NEXT|PREV|[SEEK key] ?kVarName? ?dVarName?\"", (char *) NULL);
  350.         return TCL_ERROR;
  351.         }
  352.  
  353.     for (index = 0 ; index < _max_dbs_ ; ++index)
  354.         {
  355.         if (strcmp(_dbs_[index].name, argv[1]) == SAMESTR)
  356.             break;
  357.         }
  358.  
  359.     if (index >= _max_dbs_)
  360.         {
  361.         Tcl_AppendResult(interp, "\"", argv[0], "\" DB \"",
  362.                             argv[1], "\" not found", (char *) NULL);
  363.         return TCL_ERROR;
  364.         }
  365.     else
  366.         {
  367.         dvarname = NULL;
  368.         kvarname = NULL;
  369.         key.data = "";
  370.         key.size = 0;
  371.         if (strcmp(argv[2], "FIRST") == 0)
  372.             {
  373.             if (argc >= 4)
  374.                 kvarname = argv[3];
  375.             if (argc >= 5)
  376.                 dvarname = argv[4];
  377.             flags = R_FIRST;
  378.             }
  379.         else if (strcmp(argv[2], "LAST") == 0)
  380.             {
  381.             if (argc >= 4)
  382.                 kvarname = argv[3];
  383.             if (argc >= 5)
  384.                 dvarname = argv[4];
  385.             flags = R_LAST;
  386.             }
  387.         else if (strcmp(argv[2], "NEXT") == 0)
  388.             {
  389.             if (argc >= 4)
  390.                 kvarname = argv[3];
  391.             if (argc >= 5)
  392.                 dvarname = argv[4];
  393.             flags = R_NEXT;
  394.             }
  395.         else if (strcmp(argv[2], "PREV") == 0)
  396.             {
  397.             if (argc >= 4)
  398.                 kvarname = argv[3];
  399.             if (argc >= 5)
  400.                 dvarname = argv[4];
  401.             flags = R_PREV;
  402.             }
  403.         else if (strcmp(argv[2], "SEEK") == 0)
  404.             {
  405.             key.data = argv[3];
  406.             key.size = strlen(argv[3]) + 1;
  407.             
  408.             if (argc >= 5)
  409.                 kvarname = argv[4];
  410.             
  411.             if (argc >= 6)
  412.                 dvarname = argv[5];
  413.             
  414.             flags = R_CURSOR;
  415.             }
  416.         
  417.         result = (* _dbs_[index].db->seq) (_dbs_[index].db, &key, &data, flags);
  418.         if (result < 0)
  419.             {
  420.             Tcl_AppendResult(interp, "\"", argv[0], "\" DB error", (char *) NULL);
  421.             return TCL_ERROR;
  422.             }
  423.         else if (result > 0)
  424.             {
  425.             Tcl_AppendResult(interp, "\"", argv[0], "\" no more keys", (char *) NULL);
  426.             return TCL_ERROR;
  427.             }
  428.         else
  429.             {
  430.             if (kvarname != NULL)
  431.                 Tcl_SetVar(interp, kvarname, key.data, 0);
  432.             else
  433.                 Tcl_AppendResult(interp, "{", key.data, "}", (char *) NULL);
  434.  
  435.             if (dvarname != NULL)
  436.                 Tcl_SetVar(interp, dvarname, data.data, 0);
  437.             else
  438.                 Tcl_AppendResult(interp, (kvarname != NULL ? "{" : " {"),
  439.                                             data.data, "}", (char *) NULL);
  440.  
  441.             return TCL_OK;
  442.             }
  443.         }
  444.     }
  445.  
  446. int
  447. Cmd_CBTClose(clientData, interp, argc, argv)
  448. char        *clientData;
  449. Tcl_Interp    *interp;
  450. int            argc;
  451. char        **argv;
  452. {
  453. int        index, result;
  454. #pragma unused (clientData)
  455.  
  456.     if (argc != 2)
  457.         {
  458.         Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  459.             " dbName\"", (char *) NULL);
  460.         return TCL_ERROR;
  461.         }
  462.  
  463.     for (index = 0 ; index < _max_dbs_ ; ++index)
  464.         {
  465.         if (strcmp(_dbs_[index].name, argv[1]) == SAMESTR)
  466.             break;
  467.         }
  468.  
  469.     if (index >= _max_dbs_)
  470.         {
  471.         Tcl_AppendResult(interp, "\"", argv[0], "\" DB \"",
  472.                             argv[1], "\" not found", (char *) NULL);
  473.         return TCL_ERROR;
  474.         }
  475.     else
  476.         {
  477.         result = (* _dbs_[index].db->close) (_dbs_[index].db);
  478.         free(_dbs_[index].db);
  479.         _dbs_[index].db = (DB *)0;
  480.         strcpy(_dbs_[index].name, "--CLOSED--");
  481.         return TCL_OK;
  482.         }
  483.     }
  484.  
  485. Tcl_InitCBTREE(interp)
  486. Tcl_Interp    *interp;
  487.     {
  488.     Tcl_CreateCommand(interp, "cbt_open", Cmd_CBTOpen,
  489.                         (ClientData)NULL, (void (*)())NULL);
  490.     Tcl_CreateCommand(interp, "cbt_close", Cmd_CBTClose,
  491.                         (ClientData)NULL, (void (*)())NULL);
  492.     Tcl_CreateCommand(interp, "cbt_insert", Cmd_CBTInsert,
  493.                         (ClientData)NULL, (void (*)())NULL);
  494.     Tcl_CreateCommand(interp, "cbt_getkey", Cmd_CBTGetKey,
  495.                         (ClientData)NULL, (void (*)())NULL);
  496.     Tcl_CreateCommand(interp, "cbt_delete", Cmd_CBTDelete,
  497.                         (ClientData)NULL, (void (*)())NULL);
  498.     Tcl_CreateCommand(interp, "cbt_seq", Cmd_CBTSeq,
  499.                         (ClientData)NULL, (void (*)())NULL);
  500.     }
  501.